home *** CD-ROM | disk | FTP | other *** search
/ Resource for Source: C/C++ / Resource for Source - C-C++.iso / misc_src / viswrite / mdidemo.bas < prev    next >
Encoding:
BASIC Source File  |  1995-11-01  |  10.7 KB  |  314 lines
  1. Option Explicit
  2.  
  3. Global Const A4WidthInTwips = 11905 '21cm in twips
  4. Global Const A4LengthInTwips = 15307 '27cm in twips
  5. Global Const TWIPS_IN_MM = 56.7
  6. Global Const TWIPS_IN_CM = 567
  7.  
  8. Type FormState
  9.     Deleted As Integer
  10.     Dirty As Integer
  11.     Ignore As Integer
  12. End Type
  13. Global FState()  As FormState
  14. Global Document() As New frmMDIChild
  15. Global gFindString, gFindCase As Integer, gFindDirection As Integer
  16. Global gCurPos As Integer, gFirstTime As Integer
  17. Global ArrayNum As Integer
  18.  
  19. '-------------------------------------------------------------------------
  20. ' AnyPadsLeft
  21. '
  22. ' Look for a free entry in the document array
  23. '-------------------------------------------------------------------------
  24. Function AnyPadsLeft () As Integer
  25.     Dim i As Integer
  26.  
  27.     ' Cycle throught the document array.
  28.     ' Return True if there is at least one
  29.     ' open document remaining.
  30.     For i = 1 To UBound(Document)
  31.         If Not FState(i).Deleted Then
  32.             AnyPadsLeft = True
  33.             Exit Function
  34.         End If
  35.     Next
  36.  
  37. End Function
  38.  
  39. '-------------------------------------------------------------------------
  40. ' EditCopyProc
  41. '
  42. ' Copy selected text to the clipboard
  43. '-------------------------------------------------------------------------
  44. Sub EditCopyProc ()
  45.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_COPY
  46. End Sub
  47.  
  48. '-------------------------------------------------------------------------
  49. ' EditCutProc
  50. '
  51. ' Cuts selected text and copy it to clipboard
  52. '-------------------------------------------------------------------------
  53. Sub EditCutProc ()
  54.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_CUT
  55. End Sub
  56.  
  57. '-------------------------------------------------------------------------
  58. ' EditDeleteProc
  59. '
  60. ' Deletes selected text (or next character)
  61. '-------------------------------------------------------------------------
  62. Sub EditDeleteProc ()
  63.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_CLEAR
  64. End Sub
  65.  
  66. '-------------------------------------------------------------------------
  67. ' EditFindReplaceProc
  68. '
  69. ' Call find or replace dialog
  70. '
  71. ' Parameters: 1 find dialog
  72. '             2 replace dialog
  73. '-------------------------------------------------------------------------
  74. Sub EditFindReplaceProc (Flag As Integer)
  75.     frmMDIParent.ActiveForm.TextControl1.FindReplace = Flag
  76. End Sub
  77.  
  78. '-------------------------------------------------------------------------
  79. ' EditPasteProc
  80. '
  81. ' Paste clipboard data
  82. '-------------------------------------------------------------------------
  83. Sub EditPasteProc ()
  84.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_PASTE
  85. End Sub
  86.  
  87. '-------------------------------------------------------------------------
  88. ' EditSelectAll
  89. '
  90. ' Select whole text
  91. '-------------------------------------------------------------------------
  92. Sub EditSelectAll ()
  93.     Dim nPointer As Integer     'MousePointer proterty value
  94.  
  95.     nPointer = frmMDIParent.ActiveForm.TextControl1.MousePointer
  96.     frmMDIParent.ActiveForm.TextControl1.MousePointer = 11
  97.     frmMDIParent.ActiveForm.TextControl1.SelStart = 0
  98.     frmMDIParent.ActiveForm.TextControl1.SelLength = -1
  99.     frmMDIParent.ActiveForm.TextControl1.MousePointer = nPointer
  100. End Sub
  101.  
  102. Sub EditSpellCheckProc ()
  103.  
  104. frmMDIParent.ActiveForm.TextControl1.VTSpellCheck = True
  105. MsgBox "Spell Checking is Complete."
  106.  
  107. End Sub
  108.  
  109. '-------------------------------------------------------------------------
  110. ' EnableToolbarButtons
  111. '
  112. '-------------------------------------------------------------------------
  113. Sub EnableToolbarButtons ()
  114.     If AnyPadsLeft() Then
  115.         frmMDIParent!imgFileSaveButton.Picture = frmMDIParent!imgFileSaveButtonUp.Picture
  116.         frmMDIParent!imgFileSaveButton.Enabled = True
  117.         frmMDIParent!imgCutButton.Picture = frmMDIParent!imgCutButtonUp.Picture
  118.         frmMDIParent!imgCutButton.Enabled = True
  119.         frmMDIParent!imgCopyButton.Picture = frmMDIParent!imgCopyButtonUp.Picture
  120.         frmMDIParent!imgCopyButton.Enabled = True
  121.         frmMDIParent!imgPasteButton.Picture = frmMDIParent!imgPasteButtonUp.Picture
  122.         frmMDIParent!imgPasteButton.Enabled = True
  123.     Else
  124.         frmMDIParent!imgFileSaveButton.Picture = frmMDIParent!imgFileSaveButtonDis.Picture
  125.         frmMDIParent!imgFileSaveButton.Enabled = False
  126.         frmMDIParent!imgCutButton.Picture = frmMDIParent!imgCutButtonDis.Picture
  127.         frmMDIParent!imgCutButton.Enabled = False
  128.         frmMDIParent!imgCopyButton.Picture = frmMDIParent!imgCopyButtonDis.Picture
  129.         frmMDIParent!imgCopyButton.Enabled = False
  130.         frmMDIParent!imgPasteButton.Picture = frmMDIParent!imgPasteButtonDis.Picture
  131.         frmMDIParent!imgPasteButton.Enabled = False
  132.     End If
  133. End Sub
  134.  
  135. '-------------------------------------------------------------------------
  136. ' FileNewProc
  137. '
  138. ' Initialize a new window
  139. '-------------------------------------------------------------------------
  140. Sub FileNewProc ()
  141.     Dim fIndex As Integer
  142.  
  143.     fIndex = FindFreeIndex()
  144.     If fIndex <> 0 Then
  145.         Document(fIndex).Tag = fIndex
  146.         Document(fIndex).Caption = "Untitled:" & fIndex
  147.         Document(fIndex).TXRuler1.ScaleUnits = SCALE_MM
  148.         Document(fIndex).Show
  149.  
  150.         ' Make sure toolbar edit buttons are visible
  151.         frmMDIParent!imgCutButton.Visible = True
  152.         frmMDIParent!imgCopyButton.Visible = True
  153.         frmMDIParent!imgPasteButton.Visible = True
  154.     End If
  155.     
  156. End Sub
  157.  
  158. '-------------------------------------------------------------------------
  159. ' FindFreeIndex
  160. '
  161. '-------------------------------------------------------------------------
  162. Function FindFreeIndex () As Integer
  163.     Dim i As Integer
  164.     Dim ArrayCount As Integer
  165.  
  166.     ArrayCount = UBound(Document)
  167.  
  168.     ' Cycle throught the document array. If one of the
  169.     ' documents has been deleted, then return that
  170.     ' index.
  171.     For i = 1 To ArrayCount
  172.         If FState(i).Deleted Then
  173.             FindFreeIndex = i
  174.             FState(i).Deleted = False
  175.             FState(i).Ignore = False
  176.             Exit Function
  177.         End If
  178.     Next
  179.  
  180.     ' If none of the elements in the document array have
  181.     ' been deleted, then increment the document and the
  182.     ' state arrays by one and return the index to the
  183.     ' new element.
  184.  
  185.     ReDim Preserve Document(ArrayCount + 1)
  186.     ReDim Preserve FState(ArrayCount + 1)
  187.     FindFreeIndex = UBound(Document)
  188. End Function
  189.  
  190. '-------------------------------------------------------------------------
  191. ' FormatColorProc
  192. '
  193. ' Set text or background color
  194. '-------------------------------------------------------------------------
  195. Sub FormatColorProc (Index As Integer)
  196.     Dim lOldColor As Long
  197.  
  198.     On Error Resume Next
  199.  
  200.     If Index = COLOR_TEXT Then
  201.         lOldColor = frmMDIParent.ActiveForm.TextControl1.TextColor
  202.     Else
  203.         lOldColor = frmMDIParent.ActiveForm.TextControl1.BackColor
  204.     End If
  205.  
  206.     If lOldColor = -1 Then
  207.         frmMDIParent.CMDialog1.Color = 0  'use black if different colors
  208.     Else
  209.         frmMDIParent.CMDialog1.Color = lOldColor
  210.     End If
  211.  
  212.     frmMDIParent.CMDialog1.Flags = CC_RGBINIT Or CC_PREVENTFULLOPEN
  213.     frmMDIParent.CMDialog1.CancelError = True
  214.     frmMDIParent.CMDialog1.Action = DLG_COLOR
  215.     If Err Then Exit Sub
  216.  
  217.     'set new color
  218.  
  219.     If lOldColor = -1 Or frmMDIParent.CMDialog1.Color <> lOldColor Then
  220.         If Index = COLOR_TEXT Then
  221.             frmMDIParent.ActiveForm.TextControl1.TextColor = frmMDIParent.CMDialog1.Color
  222.         Else
  223.             frmMDIParent.ActiveForm.TextControl1.BackColor = frmMDIParent.CMDialog1.Color
  224.         End If
  225.     End If
  226. End Sub
  227.  
  228. '-------------------------------------------------------------------------
  229. ' FormatDocProc
  230. '
  231. ' Call the document formatting dialog
  232. '-------------------------------------------------------------------------
  233. Sub FormatDocProc ()
  234.     frmDocDlg.Show 1
  235. End Sub
  236.  
  237. '-------------------------------------------------------------------------
  238. ' FormatFramesProc
  239. '
  240. ' Call the paragraph frames dialog
  241. '-------------------------------------------------------------------------
  242. Sub FormatFramesProc ()
  243.     frmFramesDlg.Show 1
  244. End Sub
  245.  
  246. '-------------------------------------------------------------------------
  247. ' ResizeChild
  248. '
  249. ' Resize a text window
  250. '-------------------------------------------------------------------------
  251. Sub ResizeChild (frmCurrent As Form)
  252.     
  253.     'Switch background color to gray if child window gets
  254.     'bigger than maximum TX width (30% zoom on large screens)
  255.     If frmCurrent.Width > frmCurrent!TextControl1.Width Then
  256.         frmCurrent.BackColor = &HC0C0C0
  257.     Else
  258.         frmCurrent.BackColor = &HFFFFFF
  259.     End If
  260.     
  261.     'Resize TX window when MDI child is resized. Do not resize
  262.     'if window is too small.
  263.     If frmCurrent.WindowState <> 1 And frmCurrent.ScaleHeight - frmCurrent!TXRuler1.Height > 0 Then
  264.         frmCurrent!TextControl1.Height = frmCurrent.ScaleHeight
  265.         If (frmCurrent!TXRuler1.Visible) Then
  266.             frmCurrent!TextControl1.Height = frmCurrent!TextControl1.Height - frmCurrent!TXRuler1.Height
  267.         End If
  268.     End If
  269. End Sub
  270.  
  271. '-------------------------------------------------------------------------
  272. ' ViewParagraphBarProc
  273. '
  274. ' Switch button bar visible state
  275. '-------------------------------------------------------------------------
  276. Sub ViewParagraphBarProc (frmCurrent As Form)
  277.     frmMDIParent!TXButtonBar1.Visible = Not frmMDIParent!TXButtonBar1.Visible
  278.     frmCurrent!mnuView_ParagraphBar.Checked = frmMDIParent!TXButtonBar1.Visible
  279.     frmMDIParent!picToolbar.Top = 0
  280. End Sub
  281.  
  282. '-------------------------------------------------------------------------
  283. ' ViewRulerProc
  284. '
  285. ' Switch the ruler visible state
  286. '-------------------------------------------------------------------------
  287. Sub ViewRulerProc (frmCurrent As Form)
  288.     frmCurrent!TXRuler1.Visible = Not frmCurrent!TXRuler1.Visible
  289.     frmCurrent!mnuView_Ruler.Checked = frmCurrent!TXRuler1.Visible
  290.     ResizeChild frmCurrent
  291. End Sub
  292.  
  293. '-------------------------------------------------------------------------
  294. ' ViewStatusBarProc
  295. '
  296. ' Switch the status bar visible state
  297. '-------------------------------------------------------------------------
  298. Sub ViewStatusBarProc (frmCurrent As Form)
  299.     frmMDIParent!TXStatusBar1.Visible = Not frmMDIParent!TXStatusBar1.Visible
  300.     frmCurrent!mnuView_StatusBar.Checked = frmMDIParent!TXStatusBar1.Visible
  301. End Sub
  302.  
  303. '-------------------------------------------------------------------------
  304. ' ViewToolBarProc
  305. '
  306. ' Switch the toolbar visible state
  307. '-------------------------------------------------------------------------
  308. Sub ViewToolBarProc (frmCurrent As Form)
  309.     frmMDIParent!picToolbar.Visible = Not frmMDIParent!picToolbar.Visible
  310.     frmCurrent!mnuView_Toolbar.Checked = frmMDIParent!picToolbar.Visible
  311.     frmMDIParent!picToolbar.Top = 0
  312. End Sub
  313.  
  314.